home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TURBOK50.LZH / SOURCE.ARC / IOTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1989-06-02  |  62KB  |  1,825 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.01a                             }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:    IOTTT5          }
  14.                      {--------------------------------}
  15.  
  16. {Change history:  2/24/89 5.00a    Added default Jump_Full setting line 900
  17.                   2/26/89 5.00b    Added exit statement line 1339
  18.                   2/28/89 5.00c    Modified insert proc line 1497
  19.                           5.00d    Expanded Display_All_Fields line 1188
  20.                   3/05/89 5.00e    Changed default Allow_Esc to true
  21.                           5.00f    Reduced size of Table Settings structure
  22.                   3/12/89 5.00g    Added cursor keys etc. to Allow_Char logic
  23.                                    lines 226 & 1568
  24.                           5.00h    Modified field rules logic to permit
  25.                                    Field_Rules to be called before XXX_Field
  26.                                    e.g. Real_Field
  27.                           5.00i    Changed Cursor positioning logic for
  28.                                    fields  line 593, 1315, 1331
  29.                           5.00j    Improved insert procedure and added proc
  30.                                    Init_Insert_Mode;
  31.                           5.00k    Corrected Refresh_Fields bug in non IOFULL
  32.                                    state.
  33.                           5.00l    Changed Erase_Default logic to work when
  34.                                    jumping
  35.                           5.00m    Added Enter Field Hook for first field
  36.             April 1, 89   5.01     Added error checking for TableSet,
  37.                                    and changed error level on fatal
  38.                           5.01a    Added debug compiler directive, fixed
  39.                                    global erase, remove references to VER50
  40. }
  41.  
  42.  
  43. {$S-,R-,V-}
  44.  
  45. {$IFNDEF DEBUG}
  46. {$D-}
  47. {$ENDIF}
  48.  
  49. Unit IOTTT5;
  50.  
  51. (*
  52. {$DEFINE IOFULL}
  53. *)
  54.  
  55. INTERFACE
  56.  
  57. uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, StrnTTT5, MiscTTT5;
  58.  
  59. CONST
  60. MaxTables      = 10;       {alter as necessary}
  61. MaxInputFields = 40;       {alter as necessary}
  62.  
  63. IOUndefined = 0;
  64. {$IFDEF IOFULL}
  65. IOString   = 1;
  66. IOByte     = 2;
  67. IOWord     = 3;
  68. IOInteger  = 4;
  69. IOLongInt  = 5;
  70. IOReal     = 6;
  71. IOPassword = 7;
  72. IOSelect   = 8;
  73. IODate     = 9;
  74.  
  75. AllowNull    = $01;
  76. SuppressZero = $02;
  77. RightJustify = $04;
  78. EraseDefault = $08;
  79. JumpIfFull   = $10;
  80.  
  81. Default_Allow_Null    :boolean = true;
  82. Default_Suppress_Zero :boolean = true;
  83. Default_Right_Justify :boolean = false;
  84. Default_Erase_Default :boolean = false;
  85. Default_Jump_Full     :boolean = false;
  86. Default_Allow_Char    :set of char = [#0];
  87. Default_DisAllow_Char :set of char = [#0];
  88. {$ENDIF}
  89. Refresh_None    = 0;
  90. Refresh_Current = 1;
  91. Refresh_All     = 2;
  92. End_Input       = 99;
  93. No_Char         = #0;
  94.  
  95. TYPE
  96. {$IFNDEF VER40}
  97. Move_Field_Proc = procedure(var CurrentField:byte;var Refresh:byte);
  98. Char_Hook_Proc   = procedure(var Ch : char; var CurrentField:byte;var Refresh:byte);
  99. Insert_Proc      = procedure(Insert:boolean);
  100. {$ENDIF}
  101.  
  102. IOCharSet = Set of char;
  103. Str_Field_Defn = record
  104.                       Upfield   : byte;
  105.                       Downfield : byte;
  106.                       Leftfield : byte;
  107.                       Rightfield: byte;
  108.                       X         : byte;
  109.                       Y         : byte;
  110.                       Message   : strscreen;        {5.00f}
  111.                       MsgX      : byte;
  112.                       MsgY      : byte;
  113.                       CursorX   : byte;
  114.                       StrLocX   : byte;
  115.                       FieldLen  : byte;
  116.                       FieldStr  : strscreen;
  117.                       FieldFmt    : strscreen;       {5.00f}
  118.                       Right_Justify : boolean;
  119.                       {$IFDEF IOFULL}
  120.                       RealDP        : byte;
  121.                       Allow_Null    : boolean;
  122.                       Suppress_Zero : Boolean;
  123.                       Erase_Default : boolean;
  124.                       Jump_Full     : boolean;
  125.                       Allow_Char    : set of char;
  126.                       DisAllow_Char : set of char;
  127.                       Rules_Set     : Boolean;    {5.00h}
  128.                       case FieldType:byte of
  129.                            IOString   : (SPtr: ^string);
  130.                            IOByte     : (BPtr: ^Byte;BMax:byte;BMin:byte);
  131.                            IOWord     : (WPtr: ^Word;WMax:word;WMin:word);
  132.                            IOInteger  : (IPtr: ^Integer;IMax:integer;IMin:Integer);
  133.                            IOLongInt  : (LPtr: ^LongInt;LMax:longint;LMin:longInt);
  134.                            IOReal     : (RPtr: ^Real;RMax:real;RMin:Real);
  135.                            IODate     : (DPtr: ^Dates;DFormat:byte;DMax:Dates;DMin:Dates);
  136.                       {$ELSE}
  137.                       FieldType : byte;
  138.                       SPtr : ^string;
  139.                       {$ENDIF}
  140.                 end;
  141.  
  142. Str_Field_Ptr = ^Str_Field_Defn;
  143.  
  144. TableSettings = record
  145.                      HiFCol  : byte;
  146.                      HiBCol  : byte;
  147.                      LoFCol  : byte;
  148.                      LoBCol  : byte;
  149.                      MsgFCol : byte;
  150.                      MsgBCol : byte;
  151.                      TotalFields: byte;
  152.                      CurrentField : byte;
  153.                      AllowEsc : boolean;
  154.                      IO_FieldsSet : boolean;
  155.                      Displayed   : boolean;
  156.                      Beep : boolean;
  157.                      WhiteSpace : char;
  158.                      ErrorLine : byte;
  159.                      Insert : boolean;
  160.                      {$IFNDEF VER40}
  161.                      LeaveFieldHook : Move_Field_Proc;
  162.                      EnterFieldHook : Move_Field_Proc;
  163.                      CharHook   : Char_Hook_Proc;
  164.                      InsertProc : Insert_Proc;
  165.                      {$ENDIF}
  166.                      FinishChar : char;
  167.                 end;
  168.  
  169. TableRec = record
  170.                 FieldDefn: array[0..MaxInputFields] of Str_Field_Ptr;
  171.                 ITTT: TableSettings;
  172.            end;
  173.  
  174. TablePtr = ^TableRec;
  175.  
  176.  
  177. VAR
  178.   CurrentTable : byte;
  179.   TableSet: boolean;
  180.   TotalTables : byte;
  181.   Table : array[1..MaxTables] of TablePtr;
  182.   I_Char : char;
  183.   {$IFDEF VER40}
  184.   IO_LeaveHook,
  185.   IO_EnterHook,
  186.   IO_CharHook,
  187.   IO_InsertHook : pointer;
  188.   {$ENDIF}
  189.  
  190. Procedure Create_Tables(No_Of_Tables:byte);
  191. Procedure Activate_Table(Table_no:byte);
  192. {$IFNDEF VER40}
  193. Procedure Assign_LeaveFieldHook(Proc:Move_Field_Proc);
  194. Procedure Assign_EnterFieldHook(Proc:Move_Field_Proc);
  195. Procedure Assign_CharHook(Proc:Char_Hook_Proc);
  196. Procedure Assign_InsHook(Proc:Insert_Proc);
  197. {$ENDIF}
  198. Procedure Create_Fields(No_of_fields:byte);
  199. Procedure Define_Colors(HiF,HiB,LoF,LoB,MsgF,MsgB:byte);
  200. Procedure Add_Message(DefID,DefX,DefY : byte; DefString : string);
  201. Procedure Add_Field(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte);
  202. Procedure String_Field(DefID:byte;var Strvar:String;DefFormat:string);
  203. {$IFDEF IOFULL}
  204. Procedure Assign_Finish_Char(Ch : char);
  205. Procedure Byte_Field(DefID:byte;var ByteVar:Byte;DefFormat:string;Min,Max:byte);
  206. Procedure Word_Field(DefID:byte;var Wordvar:Word;DefFormat:string;Min,Max:word);
  207. Procedure Integer_Field(DefID:byte;var Integervar:Integer;DefFormat:string;Min,Max:integer);
  208. Procedure LongInt_Field(DefID:byte;var LongIntvar:LongInt;DefFormat:string;Min,Max:LongInt);
  209. Procedure Date_Field(DefID:byte;var Datevar:Dates;DateFormat:byte;DefFormat:string;
  210.                       Min,Max : Dates);
  211. Procedure Real_Field(DefID:byte;var Realvar:Real;DefFormat:string;Min,Max:real);
  212. Procedure Set_Default_Rules(Rules:word);
  213. Procedure Field_Rules(DefID:byte;Rules:word;AChar:IOcharset;DChar:IOcharset);
  214. {$ENDIF}
  215. Procedure Display_All_Fields;
  216. Procedure Allow_Esc(OK:boolean);
  217. Procedure Allow_Beep(OK:boolean);
  218. Procedure Init_Insert_Mode(ON:boolean);         {5.00j}
  219. Procedure Dispose_Fields;
  220. Procedure Dispose_Tables;
  221. Procedure Process_Input(StartField:byte);
  222.  
  223. implementation
  224.  
  225. Const
  226.     Valid    = 0;
  227.     NotValid = 1;
  228.     EscValid = 2;
  229.  
  230.     FmtChars  : set of char = ['!','#','@','*'];
  231.     IOUp       = #200;
  232.     IODown     = #208;
  233.     IORight    = #205;
  234.     IOLeft     = #203;
  235.     IODel      = #211;
  236.     IOTotErase = #146;    {Alt-E}
  237.     IOErase    = #160;    {Alt-D}
  238.     IOFinish   = #196;    {F10}   {can be over ridden with ASSIGN_FINISH_CHAR}
  239.     IOEsc      = #27;
  240.     IOTab      = #9;
  241.     IOShiftTab = #143;
  242.     IOEnter    = #13;
  243.     IOIns      = #210;
  244.     IOBackSp   = #8;
  245.     IORightFld = #244;
  246.     IOLeftFld  = #243;
  247.     Control_Char : set of char = [IOUp,IODown,IORight,IOLeft,IODel,    {5.00g}
  248.                                   IOTotErase,IOErase, IOEsc,
  249.                                   IOTab, IOShiftTab, IOEnter, IOIns,
  250.                                   IOBackSp, IORightFld, IOLeftFld];
  251. VAR
  252.    FirstCharPress : boolean;
  253.  
  254. {$F+}
  255. procedure NoFieldHook(var CurrentField:byte;var Refresh:byte);
  256. begin
  257. end;
  258.  
  259. procedure NoCharHook(var Ch : char; var CurrentField:byte;var Refresh:byte);
  260. begin
  261. end;
  262.  
  263. Procedure DefaultInsertHook(On:boolean);
  264. begin
  265.     If ON then
  266.        OnCursor
  267.     else
  268.        FullCursor;
  269. end;
  270. {$F-}
  271.  
  272. {$IFDEF VER40}
  273. Procedure CallEnterFieldHook(var CurrentField:byte;var Refresh:byte);
  274.           Inline($FF/$1E/IO_EnterHook);
  275.  
  276. Procedure CallLeaveFieldHook(var CurrentField:byte;var Refresh:byte);
  277.           Inline($FF/$1E/IO_LeaveHook);
  278.  
  279. Procedure CallCharHook(var Ch : char; var CurrentField:byte;var Refresh:byte);
  280.           Inline($FF/$1E/IO_CharHook);
  281.  
  282. Procedure CallInsertHook(On:boolean);
  283.           Inline($FF/$1E/IO_InsertHook);
  284. {$ENDIF}
  285.  
  286. Procedure IOTTT_Error(Code:byte;value:real);    {fatal error -- msg and halt}
  287. var Message:string;
  288. begin
  289.     Case Code of
  290.     1 : Message := 'Error 1: Invalid value of '+Real_to_Str(value,0)
  291.                    +' in Create_Fields with a MaxInputFields of '
  292.                    +Real_to_Str(MaxInputFields,0);
  293.     2 : Message := 'Error 2 : Insufficient Memory on Heap. Available '
  294.                    +Real_to_Str(MaxAvail,0)+'. Required '
  295.                    +Real_to_Str(value,0);
  296.     3 : Message := 'Error 3 : Field operation not allowed before before Create_Fields';
  297.     4 : Message := 'Error 4 : Field ID: '
  298.                    +Real_to_Str(value,0)+' out of range';
  299.     5 : Message := 'Error 5 : cannot change fields, invalid target field ID: '
  300.                    +Real_to_Str(value,0);
  301.     6 : message := 'Error 6 : Invalid X or Y value defined in Add_Field ID: '
  302.                    +Real_to_Str(value,0);
  303.     7 : Message := 'Error 7 : Cannot Add_message before calling Add_Field';
  304.     8 : Message := 'Error 8 : Cannot Add_Message, invalid Field ID: '+Real_to_Str(value,0);
  305.     9 : message := 'Error 9 : Invalid X or Y coordinate defined in Add_Message ID: '
  306.                    +Real_to_Str(value,0);
  307.     10 : Message := 'Error 10 : Cannot Dispose_fields, no fields exist';
  308.     11 : Message := 'Error 11 : Cannot Create_Fields - fields already created,'
  309.                     +' reset with Dispose_fields';
  310.     12 : Message := 'Error 12 : Use Create_Tables before Activate_Table';
  311.     13 : Message := 'Error 13 : Cannot Activate_Table - Table outside range';
  312.     14 : Message := 'Error 14 : call Create_Tables or Create_Fields first';
  313.     else Message := 'Aborting';
  314.     end; {case}
  315.     WriteAT(1,12,black,lightgray,Message);
  316.     Repeat Until keypressed;
  317.     Halt(10);     {IO fatal error returns an error level of 10}  {5.01}
  318. end;    {proc IOTTT_Error}
  319.  
  320. Procedure Ding;
  321. begin
  322.     If Table[CurrentTable]^.ITTT.Beep then
  323.     begin
  324.        sound(750);delay(150);nosound;
  325.     end;
  326. end;    {proc Ding}
  327.  
  328. Procedure Reset_Table(var T: TableSettings);
  329. begin
  330.     with T do
  331.     begin
  332.         HiFCol := white;
  333.         HiBCol := blue;
  334.         LoFCol := blue;
  335.         LoBCol := lightgray;
  336.         MsgFCol:= yellow;
  337.         MsgBCol:= red;
  338.         TotalFields:=MaxInputFields;
  339.         CurrentField := 1;
  340.         AllowEsc := true;                  {5.00e}
  341.         IO_FieldsSet := false;
  342.         Displayed    := false;
  343.         Beep    := true;
  344.         WhiteSpace   := #250;
  345.         ErrorLine := 24;
  346.         Insert := true;
  347.         {$IFNDEF VER40}
  348.         LeaveFieldHook := NoFieldHook;
  349.         EnterFieldHook := NoFieldHook;
  350.         CharHook := NoCharHook;
  351.         InsertProc := DefaultInsertHook;
  352.         {$ELSE}
  353.         IO_LeaveHook  := nil;
  354.         IO_EnterHook  := nil;
  355.         IO_CharHook   := nil;
  356.         IO_InsertHook := @DefaultInsertHook;
  357.         {$ENDIF}
  358.         FinishChar := IOFinish;
  359.     end;
  360. end;
  361.  
  362. Procedure Create_Tables(No_Of_Tables:byte);
  363. var
  364.   I:integer;
  365.   Room_needed : integer;
  366. begin
  367.     If No_of_Tables in [1..MaxTables] then
  368.     begin
  369.         Room_needed := sizeof(Table[1]^);
  370.         For I := 1 to No_of_Tables do
  371.         begin
  372.             If MaxAvail >= Room_needed then
  373.             begin
  374.                 GetMem(Table[I],Room_Needed);
  375.                 Reset_Table(Table[I]^.ITTT)
  376.             end
  377.             else  {not enough heap space}
  378.                     IOTTT_Error(2,Room_needed); {end MemAvail If clause}
  379.         end;
  380.         TotalTables := No_Of_Tables;
  381.     end;
  382.     TableSet := true;
  383. end;   {IO_SetTables}
  384.  
  385.  Procedure Activate_Table(Table_No:byte);
  386.  {}
  387.  begin
  388.      If not TableSet then
  389.         IOTTT_Error(12,0.0);
  390.      If Table_No > TotalTables then
  391.         IOTTT_Error(13,0.0);
  392.      CurrentTable := Table_No
  393.  end; {of proc Activate_Table}
  394. {$IFNDEF VER40}
  395.  
  396.  Procedure Assign_LeaveFieldHook(Proc:Move_Field_Proc);
  397.  {}
  398.  begin
  399.      If not TableSet then
  400.         IOTTT_Error(14,0.0);
  401.      Table[CurrentTable]^.ITTT.LeaveFieldHook := proc;
  402.  end; {of proc Assign_Field_Proc}
  403.  
  404.  Procedure Assign_EnterFieldHook(Proc:Move_Field_Proc);
  405.  {}
  406.  begin
  407.      Table[CurrentTable]^.ITTT.EnterFieldHook := proc;
  408.  end; {of proc Assign_Field_Proc}
  409.  
  410.  Procedure Assign_CharHook(Proc:Char_Hook_Proc);
  411.  {}
  412.  begin
  413.      If not TableSet then
  414.         IOTTT_Error(14,0.0);
  415.      Table[CurrentTable]^.ITTT.CharHook := proc;
  416.  end; {of proc Assign_Char_Proc}
  417.  
  418.  Procedure Assign_InsHook(Proc:Insert_Proc);
  419.  {}
  420.  begin
  421.      If not TableSet then
  422.         IOTTT_Error(14,0.0);
  423.      Table[CurrentTable]^.ITTT.InsertProc := proc;
  424.  end; {of proc Assign_Char_Proc}
  425. {$ENDIF}
  426.  
  427.  Procedure Assign_Finish_Char(Ch : char);
  428.  {}
  429.  begin
  430.      If not TableSet then
  431.         IOTTT_Error(14,0.0);
  432.      Table[CurrentTable]^.ITTT.FinishChar := Ch;
  433.  end; {of proc Assign_Finish_Char}
  434.  
  435. {$IFDEF IOFULL}
  436.  Procedure Set_Default_Rules(Rules:word);
  437.  {}
  438.  begin
  439.      If not TableSet then
  440.         IOTTT_Error(14,0.0);
  441.      Default_Allow_Null    := (Rules and AllowNull) = AllowNull;
  442.      Default_Suppress_Zero := (Rules and SuppressZero) = SuppressZero;
  443.      Default_Right_Justify := (Rules and RightJustify) = RightJustify;
  444.      Default_Erase_Default := (Rules and EraseDefault) = EraseDefault;
  445.      Default_Jump_Full     := (Rules and JumpIfFull) = JumpIfFull;
  446.  end; {of proc Set_Default_Rules}
  447. {$ENDIF}
  448.  
  449. Procedure Create_Fields(No_of_fields:byte);
  450. var
  451.   I:integer;
  452.   Room_needed : integer;
  453. begin
  454.     If not TableSet then
  455.        Create_Tables(1);
  456.     with Table[CurrentTable]^ do
  457.     begin
  458.     (*
  459.         If ITTT.IO_FieldsSet then IOTTT_Error(11,0);       {already set}
  460.     *)
  461.         If No_of_Fields in [1..MaxInputFields] then
  462.         begin
  463.             Room_needed := sizeof(FieldDefn[0]^);
  464.             For I := 0 to No_of_fields do
  465.             begin
  466.                 If MaxAvail >= Room_needed then
  467.                 begin
  468.                     GetMem(FieldDefn[I],Room_Needed);
  469.                     with FieldDefn[I]^ do
  470.                     begin
  471.                         Message     := '';
  472.                         MsgX        := 81;     {zero means auto-center}
  473.                         MsgY        := 0;
  474.                         FieldType   := IOUndefined;
  475.                         SPtr        := nil;
  476.                         FieldLen    := 0;
  477.                         FieldStr    := '';
  478.                         FieldFmt    := '';
  479.                         Right_Justify := false;
  480.                         {$IFDEF IOFULL}
  481.                         Rules_Set := False;     {5.00h}
  482.                         {$ENDIF}
  483.                     end;   {With}
  484.                 end
  485.                 else  {not enough heap space}
  486.                     IOTTT_Error(2,Room_needed); {end MemAvail If clause}
  487.             end;
  488.             ITTT.TotalFields := No_of_Fields;
  489.             ITTT.IO_FieldsSet := true;
  490.         end
  491.         else  {Invalid No_of_fields}
  492.            IOTTT_Error(1,No_of_fields);
  493.    end; {with table}
  494. end;  {Proc Create_Fields}
  495.  
  496.  Procedure Define_Colors(HiF,HiB,LoF,LoB,MsgF,MsgB:byte);
  497.  {}
  498.  begin
  499.      If not TableSet then
  500.         IOTTT_Error(14,0.0);
  501.      With Table[CurrentTable]^.ITTT do
  502.      begin
  503.          HiFCol := HiF;
  504.          HiBCol := HiB;
  505.          LoFCol := LoF;
  506.          LoBCol := LoB;
  507.          MsgFCol := MsgF;
  508.          MsgBCol := MsgB;
  509.      end;
  510.  end;    {Proc Define_Colors}
  511.  
  512.  Procedure Check_Field_Number(DefId : byte);
  513.  {internal}
  514.  begin
  515.      If not TableSet then
  516.         IOTTT_Error(14,0.0);
  517.      with Table[CurrentTable]^ do
  518.      begin
  519.          If not ITTT.IO_FieldsSet then IOTTT_Error(3,0);
  520.          If (DefID < 1) or (DefID>ITTT.TotalFields) then
  521.             IOTTT_Error(4,Defid);
  522.      end;
  523.  end; {of proc Check_Field_Number}
  524.  
  525. Procedure Add_Field(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte);
  526. begin
  527.     with Table[CurrentTable]^ do
  528.     begin
  529.         Check_Field_Number(DefID);
  530.         If  (DefX < 1) or (DefX > 80)
  531.         or  (DefY < 1) or (DefY > DisplayLines) then
  532.            IOTTT_Error(6,Defid);
  533.         With FieldDefn[DefID]^ do
  534.         begin
  535.             If DefU <= ITTT.TotalFields then
  536.                Upfield    := DefU;
  537.             If DefD <= ITTT.TotalFields then
  538.                Downfield  := DefD;
  539.             If DefL <= ITTT.TotalFields then
  540.                Leftfield  := DefL;
  541.             If DefR <= ITTT.TotalFields then
  542.                Rightfield := DefR;
  543.             X          := DefX;
  544.             Y          := DefY;
  545.         end;
  546.    end; {with Table}
  547. end; {proc ADD_Field}
  548.  
  549. Procedure Add_Message(DefID,DefX,DefY : byte; DefString : string);
  550. begin
  551.     Check_Field_Number(DefId);   {5.01}
  552.     with Table[CurrentTable]^ do
  553.     begin
  554.         If not ITTT.IO_FieldsSet then IOTTT_Error(7,0);
  555.         If (DefID < 1) or (DefID > ITTT.TotalFields) then IOTTT_Error(8,DefID);
  556.         If (DefX < 0) or (DefX > 80) or (DefY < 1) or (DefY > 25) then IOTTT_Error(9,DefID);
  557.         With FieldDefn[Defid]^ do
  558.         begin
  559.             MsgX := DefX;
  560.             MsgY := DefY;
  561.             Message := DefString;
  562.         end;
  563.     end; {with Table}
  564. end;  {proc ADD_Message}
  565.  
  566.  Function Max_string_length(DefFormat:string) : byte;
  567.  var I,Counter : byte;
  568.  begin
  569.      Counter := 0;
  570.      For I := 1 to length(DefFormat) do
  571.          if (DefFormat[I] in FmtChars) then
  572.             Counter := succ(counter);
  573.      Max_string_length := Counter;
  574.  end;  {sub func Max_String_Length}
  575.  
  576.  Function  Last_Char_Left_Justified(Str,Fmt:string): byte;
  577.  var
  578.     LenS,LenF,S,
  579.     Counter : byte;
  580.  begin
  581.      Counter := 0;
  582.      S := 0;
  583.      LenF := Length(Fmt);
  584.      LenS := Length(Str);
  585.      Repeat
  586.           Inc(Counter);
  587.           If Fmt[Counter] in FmtChars then
  588.              Inc(S);
  589.      Until (S > LenS) or (Counter > LenF);
  590.      Last_Char_Left_Justified := counter;
  591.  end;
  592.  
  593.  Function  Pos_of_Last_Input_Char(DefFormat:string): byte;
  594.  var
  595.     Counter : byte;
  596.  begin
  597.      Counter := Succ(Length(DefFormat));
  598.      Repeat
  599.           Dec(Counter);
  600.      Until (DefFormat[Counter] in FmtChars) or (Counter = 0);
  601.      Pos_of_Last_Input_Char := counter;
  602.  end;
  603.  
  604. Procedure Set_Cursor(DefID:byte);
  605. begin
  606.     with Table[CurrentTable]^.FieldDefn[DefID]^ do
  607.     begin
  608. {$IFDEF IOFULL}
  609.         If Right_Justify then
  610.         begin
  611.             CursorX := pred(X) + Pos_of_Last_Input_Char(FieldFmt);
  612.             StrLocX := length(FieldStr);
  613.         end
  614.         else       {left Justified}
  615.         begin
  616. {$ENDIF}
  617.            If FieldStr = '' then
  618.               StrLocX := 1
  619.            else
  620.            begin
  621.                StrLocX := succ(Length(FieldStr));
  622.                If StrLocX > FieldLen then
  623.                   StrLocX := FieldLen;
  624.            end;
  625.            CursorX := Last_Char_Left_Justified(FieldStr,FieldFmt);
  626.            If CursorX > length(FieldFmt) then       {5.00 I}
  627.               dec(CursorX);
  628.            CursorX := CursorX + pred(X);
  629. {$IFDEF IOFULL}
  630.         end;
  631. {$ENDIF}
  632.     end;
  633. end;
  634.  
  635.  
  636. Function Var_To_String(DefID : byte):String;
  637. var Str : string;
  638. begin
  639.     with Table[CurrentTable]^.FieldDefn[DefID]^ do
  640.     begin
  641. {$IFDEF IOFULL}
  642.         Case FieldType of
  643.         IOString  : Str := SPtr^;
  644.         IOByte    : If Suppress_Zero and (BPtr^ = 0) then
  645.                        Str := ''
  646.                     else
  647.                        Str := Int_To_Str(BPtr^);
  648.         IOWord    : If Suppress_Zero and (WPtr^ = 0) then
  649.                        Str := ''
  650.                     else
  651.                        Str := Int_To_Str(WPtr^);
  652.         IOInteger : If Suppress_Zero and (IPtr^ = 0) then
  653.                        Str := ''
  654.                     else
  655.                        Str := Int_To_Str(IPtr^);
  656.         IOLongInt : If Suppress_Zero and (LPtr^ = 0) then
  657.                        Str := ''
  658.                     else
  659.                        Str := Int_To_Str(LPtr^);
  660.         IODate    : If Suppress_Zero and (DPtr^ = 0) then
  661.                        Str := ''
  662.                     else
  663.                        Str := Unformatted_date(Julian_to_date(WPtr^,DFormat));
  664.         IOReal    : If Suppress_Zero and (RPtr^ = 0.0) then
  665.                        Str := ''
  666.                     else
  667.                     begin
  668.                         Str := Real_To_Str(RPtr^,RealDP);
  669.                         If RealDP <> Floating then
  670.                             Delete(Str,LastPos('.',Str),1);
  671.                     end;
  672.         end; {case}
  673. {$ELSE}
  674.       Str := SPtr^;
  675. {$ENDIF}
  676.     end;   {with}
  677.     Var_To_String := Str;
  678.     Set_Cursor(DefID);
  679.  end; {func Var_To_String}
  680.  
  681.  Function Formatted_String(Str,Fmt:string;RJ:boolean):string;
  682.  var
  683.  TempStr : string;
  684.  I,J : byte;
  685.  K : integer;
  686.  begin
  687. {$IFDEF IOFULL}
  688.      If RJ then
  689.      begin
  690.          J := succ(Length(Fmt));
  691.          K := length(Str);
  692.          For I := length(Fmt) downto 1 do
  693.          begin
  694.              If not (Fmt[I] in FmtChars) then
  695.              begin
  696.                  TempStr[I] := Fmt[I] ;  {force any none format charcters into string}
  697.                  dec(J);
  698.              end
  699.              else    {format character}
  700.              begin
  701.                  If K > 0  then
  702.                     TempStr[I] := Str[K]
  703.                  else
  704.                     TempStr[I] := Table[CurrentTable]^.ITTT.WhiteSpace;
  705.                  Dec(K);
  706.              end;
  707.          end;
  708.      end
  709.      else   {left Justified}
  710.      begin
  711. {$ENDIF}
  712.          J := 0;
  713.          For I := 1 to length(Fmt) do
  714.          begin
  715.              If not (Fmt[I] in FmtChars) then
  716.              begin
  717.                  TempStr[I] := Fmt[I] ;  {force any none format charcters into string}
  718.                  inc(J);
  719.              end
  720.              else    {format character}
  721.              begin
  722.                  If I - J <= length(Str) then
  723.                     TempStr[I] := Str[I - J]
  724.                  else
  725.                     TempStr[I] := Table[CurrentTable]^.ITTT.WhiteSpace;
  726.              end;
  727.          end;
  728. {$IFDEF IOFULL}
  729.      end;
  730. {$ENDIF}
  731.      TempStr[0] := char(length(Fmt));  {set initial byte to string length}
  732.      Formatted_String := Tempstr;
  733.  end;  {Func Formatted_String}
  734.  
  735. {$IFDEF IOFULL}
  736.  Procedure Invalid_Message(var CH : char);
  737.  begin
  738.    Ding;
  739.    With Table[CurrentTable]^.ITTT do
  740.    TempMessageCH(1,ErrorLine,MsgFCol,MsgBCol,
  741.                PadCenter('Invalid number - press any key ... and make correction!',80,' '),CH);
  742.  end;
  743.  
  744.  Procedure Invalid_Date_Message(var CH : char;Format:byte);
  745.  var FmtStr : string;
  746.  begin
  747.    Ding;
  748.    Case Format of
  749.    MMDDYY   : FmtStr := 'MM/DD/YY';
  750.    MMDDYYYY : FmtStr := 'MM/DD/YYYY';
  751.    MMYY     : FmtStr := 'MM/YY';
  752.    MMYYYY   : FmtStr := 'MM/YYYY';
  753.    DDMMYY   : FmtStr := 'DD/MM/YY';
  754.    DDMMYYYY : FmtStr := 'DD/MM/YYYY';
  755.    end; {case}
  756.    With Table[CurrentTable]^.ITTT do
  757.    TempMessageCH(1,ErrorLine,MsgFCol,MsgBCol,
  758.                PadCenter('Error format is '+FmtStr+'  - press any key ... and make correction!',80,' '),CH);
  759.  end;
  760.  
  761.  Procedure OutOfRange_Message(MinS,MaxS : StrScreen;var CH:char);
  762.  var
  763.    S : StrScreen;
  764.  begin
  765.      Ding;
  766.      S := 'Error value must be in the range '+MinS+' to '+MaxS+' - press any key & correct';
  767.      With Table[CurrentTable]^.ITTT do
  768.           TempMessageCh(1,ErrorLine,MsgFCol,MsgBCol,PadCenter(S,80,' '),CH);
  769.  end;
  770.  
  771.  Procedure Validate_Field(DefID:byte; var result:byte);
  772.  {}
  773.  var
  774.    VL : longint;
  775.    VR : Real;
  776.    ChV : char;
  777.    RetCode : integer;
  778.  
  779.                      Procedure Check_Number(Min,Max: longint;
  780.                                             Len : byte;
  781.                                             StrMax : string);
  782.                      {}
  783.                      begin
  784.                          with Table[CurrentTable]^.FieldDefn[DefID]^ do
  785.                          begin
  786.                              val(FieldStr,VL,Retcode);
  787.                              If Retcode <> 0 then
  788.                              begin
  789.                                  Invalid_Message(ChV);
  790.                                  If ChV = #027 then
  791.                                  begin
  792.                                     Result := EscValid;
  793.                                     FieldStr := Var_To_String(DefID);
  794.                                  end
  795.                                  else
  796.                                     Result := NotValid;
  797.                              end
  798.                              else
  799.                              begin
  800.                                  If (VL < Min)
  801.                                  or (VL > Max)
  802.                                  or ((length(FieldStr) > Len) and (FieldStr > StrMax)) then
  803.                                  begin
  804.                                     OutOfRange_Message(Int_To_Str(Min),Int_To_Str(Max),ChV);
  805.                                     If ChV = #027 then
  806.                                     begin
  807.                                        FieldStr := Var_To_String(DefID);
  808.                                        Result := EscValid;
  809.                                     end
  810.                                     else
  811.                                        Result := NotValid;
  812.                                  end
  813.                                  else
  814.                                  begin
  815.                                      Result := valid;
  816.                                  end;
  817.                              end;
  818.                          end; {with}
  819.                      end; {of proc Check_Number}
  820.  
  821.                      Procedure Check_date;
  822.                      {}
  823.                      begin
  824.                          with Table[CurrentTable]^.FieldDefn[DefID]^ do
  825.                          begin
  826.                              If not Valid_Date(FieldStr,DFormat) then
  827.                              begin
  828.                                  Invalid_Date_Message(ChV,DFormat);
  829.                                  If ChV = #027 then
  830.                                  begin
  831.                                     Result := EscValid;
  832.                                     FieldStr := Var_To_String(DefID);
  833.                                  end
  834.                                  else
  835.                                     Result := NotValid;
  836.                              end
  837.                              else
  838.                              begin
  839.                                  VL := Date_to_Julian(FieldStr,DFormat);
  840.                                  If (VL < DMin)
  841.                                  or (VL > DMax) then
  842.                                  begin
  843.                                     OutOfRange_Message(Julian_to_date(DMin,DFormat),Julian_to_date(DMax,DFormat),ChV);
  844.                                     If ChV = #027 then
  845.                                     begin
  846.                                        FieldStr := Var_To_String(DefID);
  847.                                        Result := EscValid;
  848.                                     end
  849.                                     else
  850.                                        Result := NotValid;
  851.                                  end
  852.                                  else
  853.                                  begin
  854.                                      Result := valid;
  855.                                  end;
  856.                              end;
  857.                          end; {with}
  858.                      end; {of proc Check_date}
  859.  
  860.  begin
  861.      Result := Valid; {assume alls well}
  862.      with Table[CurrentTable]^ do
  863.           with FieldDefn[DefID]^ do
  864.      begin
  865.          If (FieldStr = '') and Allow_Null then
  866.             exit;
  867.          Case FieldType of
  868.          IOByte    : Check_Number(BMin,BMax,2,'255');
  869.          IOWord    : Check_Number(WMin,WMax,4,'65535');
  870.          IOInteger : Check_Number(IMin,IMax,5,'32767');
  871.          IOLongInt : Check_Number(LMin,LMax,11,'2147483647');
  872.          IODate    : Check_Date;
  873.          IOReal    : begin
  874.                          val(  Strip('B',ITTT.WhiteSpace,
  875.                                      Formatted_String(FieldStr,FieldFmt,Right_Justify)),
  876.                                VR,
  877.                                Retcode
  878.                             );
  879.                          If Retcode <> 0 then
  880.                          begin
  881.                              Invalid_Message(ChV);
  882.                              If ChV = #027 then
  883.                              begin
  884.                                 Result := EscValid;
  885.                                 FieldStr := Var_To_String(DefID);
  886.                              end
  887.                              else
  888.                                 Result := NotValid;
  889.                          end
  890.                          else
  891.                          begin
  892.                              If (VR < RMin)
  893.                              or (VR > RMax) then
  894.                              begin
  895.                                 OutOfRange_Message(Real_To_Str(RMin,RealDP),Real_To_Str(RMax,RealDP),ChV);
  896.                                 If ChV = #027 then
  897.                                 begin
  898.                                    FieldStr := Var_To_String(DefID);
  899.                                    Result := EscValid;
  900.                                 end
  901.                                 else
  902.                                    Result := NotValid;
  903.                              end
  904.                              else
  905.                              begin
  906.                                  Result := valid;
  907.                              end;
  908.                          end;
  909.                      end;
  910.          end; {case}
  911.      end;   {with}
  912.  end; {of proc Validate_Field}
  913. {$ENDIF}
  914.  
  915.  Procedure String_To_Var(DefID : byte);
  916.  begin
  917.     with Table[CurrentTable]^ do
  918.          with FieldDefn[DefID]^ do
  919. {$IFDEF IOFULL}
  920.          begin
  921.              Case FieldType of
  922.              IOString  : SPtr^ := FieldStr;
  923.              IOByte    : BPtr^ := Str_to_Int(FieldStr);
  924.              IOWord    : WPtr^ := Str_to_Int(FieldStr);
  925.              IOInteger : IPtr^ := Str_to_Int(FieldStr);
  926.              IOLongInt : LPtr^ := Str_to_Long(FieldStr);
  927.              IOReal    : RPtr^ := Str_to_Real(Strip('B',ITTT.WhiteSpace,
  928.                                               Formatted_String(FieldStr,FieldFmt,Right_Justify)));
  929.              IODate    : If FieldStr = '' then
  930.                             DPtr^ := 0
  931.                          else
  932.                             DPtr^ := Date_to_Julian(FieldStr,Dformat);
  933.              end; {case}
  934.         end;   {with}
  935. {$ELSE}
  936.        SPTR^ := FieldStr;
  937. {$ENDIF}
  938.  end; {proc String_to_var}
  939.  
  940. {$IFDEF IOFULL}
  941.  Procedure Set_Misc_Field_Defaults(DefID:byte);
  942.  {}
  943.  begin
  944.      Check_Field_Number(DefId);   {5.01}
  945.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  946.      begin
  947.          Allow_Null    := Default_Allow_Null;
  948.          Suppress_Zero := Default_Suppress_Zero;
  949.          Right_Justify := Default_Right_Justify;
  950.          Erase_Default := Default_Erase_Default;
  951.          Allow_Char    := Default_Allow_Char;
  952.          DisAllow_Char := Default_DisAllow_Char;
  953.          Jump_Full     := Default_Jump_Full;    {fix 5.00a}
  954.          Set_Cursor(DefID);
  955.          Rules_Set := true;   {5.00h}
  956.      end;  {with}
  957.  end; {of proc Set_Misc_Field_Defaults}
  958.  
  959.  Procedure Field_Rules(DefID:byte;
  960.                        Rules:word;
  961.                        AChar: IOCharSet;
  962.                        DChar: IOCharSet);
  963.  {}
  964.  begin
  965.      Check_Field_Number(DefId);   {5.01}
  966.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  967.      begin
  968.          Allow_Null     := (Rules and AllowNull) = AllowNull;
  969.          Suppress_Zero  := (Rules and SuppressZero) = SuppressZero;
  970.          If (FieldType = IOReal)
  971.          and (RealDP > 0)
  972.          and (RealDp <> Floating) then
  973.              Right_Justify := true       {force Right_Justify}
  974.          else
  975.              Right_Justify := (Rules and RightJustify) = RightJustify;
  976.          Erase_Default := (Rules and EraseDefault) = EraseDefault;
  977.          Jump_Full := (Rules and JumpIfFull) = JumpIfFull;
  978.          Allow_Char    := Achar;
  979.          If (RealDP <> Floating) and (DChar = [#0])  then
  980.             DisAllow_Char := ['.']
  981.          else
  982.             DisAllow_Char := Dchar;
  983.          FieldStr      := Var_To_String(DefID);
  984.          Rules_Set := true;   {5.00h}
  985.      end;  {with}
  986.  end; {of proc Field_Rules}
  987. {$ENDIF}
  988.  
  989.  Procedure String_Field(DefID:byte;
  990.                         var Strvar:String;
  991.                         DefFormat:string);
  992.  {}
  993.  begin
  994.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  995.      begin
  996.          Check_Field_Number(DefID);
  997. {$IFDEF IOFULL}
  998.          FieldType     := IOString;
  999. {$ENDIF}
  1000.          SPtr          := @StrVar;
  1001.          FieldStr      := Sptr^;
  1002.          FieldFmt      := DefFormat;
  1003.          FieldLen      := Max_String_Length(FieldFmt);
  1004. {$IFDEF IOFULL}
  1005.          If Rules_Set then                 {5.00h}
  1006.             Set_Cursor(DefID)
  1007.          else
  1008.             Set_Misc_Field_Defaults(DefID);
  1009. {$ELSE}
  1010.          Set_Cursor(DefID);
  1011. {$ENDIF}
  1012.      end;
  1013.  end; {of proc String_Field}
  1014.  
  1015. {$IFDEF IOFULL}
  1016.  Procedure Byte_Field(DefID:byte;
  1017.                       var Bytevar:Byte;
  1018.                       DefFormat:string;
  1019.                       Min,Max : byte);
  1020.  {}
  1021.  begin
  1022.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1023.      begin
  1024.          Check_Field_Number(DefID);
  1025.          FieldType     := IOByte;
  1026.          If Rules_Set then                 {5.00h}
  1027.             Set_Cursor(DefID)
  1028.          else
  1029.             Set_Misc_Field_Defaults(DefID);
  1030.          SPtr          := @Bytevar;
  1031.          FieldStr := Var_To_String(DefID);
  1032.          If DefFormat = '' then
  1033.             FieldFmt := '###'
  1034.          else
  1035.             FieldFmt := DefFormat;
  1036.          If (Max = 0) or (Max < Min) then
  1037.             BMax := 255
  1038.          else
  1039.             BMax := Max;
  1040.          If Min > BMax then
  1041.             BMin := 0
  1042.          else
  1043.             BMin := Min;
  1044.          FieldLen      := Max_String_Length(FieldFmt);
  1045.          Set_Cursor(DefID);             {5.00h}
  1046.      end;
  1047.  end; {of proc Byte_Field}
  1048.  
  1049.  Procedure Word_Field(DefID:byte;
  1050.                       var Wordvar:Word;
  1051.                       DefFormat:string;
  1052.                       Min,Max : word);
  1053.  {}
  1054.  begin
  1055.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1056.      begin
  1057.          Check_Field_Number(DefID);
  1058.          FieldType     := IOWord;
  1059.          If Rules_Set then                 {5.00h}
  1060.             Set_Cursor(DefID)
  1061.          else
  1062.             Set_Misc_Field_Defaults(DefID);
  1063.          SPtr          := @WordVar;
  1064.          FieldStr      := Var_to_String(DefID);
  1065.          If DefFormat = '' then
  1066.             FieldFmt := '#####'
  1067.          else
  1068.             FieldFmt := DefFormat;
  1069.          If (Max = 0) or (Max < Min) then
  1070.              WMax := 65535
  1071.          else
  1072.             WMax := Max;
  1073.          If Min > WMax then
  1074.             WMin := 0
  1075.          else
  1076.             WMin := MIn;
  1077.          FieldLen      := Max_String_Length(FieldFmt);
  1078.          Set_Cursor(DefID);          {5.00h}
  1079.      end;
  1080.  end; {of proc Word_Field}
  1081.  
  1082.  Procedure Integer_Field(DefID:byte;
  1083.                       var Integervar:Integer;
  1084.                       DefFormat:string;
  1085.                       Min,Max:Integer);
  1086.  {}
  1087.  begin
  1088.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1089.      begin
  1090.          Check_Field_Number(DefID);
  1091.          FieldType     := IOInteger;
  1092.          If Rules_Set then                 {5.00h}
  1093.             Set_Cursor(DefID)
  1094.          else
  1095.             Set_Misc_Field_Defaults(DefID);
  1096.          Set_Misc_Field_Defaults(DefID);
  1097.          SPtr          := @IntegerVar;
  1098.          FieldStr      := Var_to_String(DefID);
  1099.          If DefFormat = '' then
  1100.             FieldFmt := '######'
  1101.          else
  1102.             FieldFmt := DefFormat;
  1103.          If (Max = 0) or (Max < Min) then
  1104.             IMax := 32767
  1105.          else
  1106.             IMax := Max;
  1107.          If Min > WMax then
  1108.             IMin := -32768
  1109.          else
  1110.             IMin := Min;
  1111.          FieldLen      := Max_String_Length(FieldFmt);
  1112.          Set_Cursor(DefID);   {5.00h}
  1113.      end;
  1114.  end; {of proc Integer_Field}
  1115.  
  1116.  Procedure LongInt_Field(DefID:byte;
  1117.                       var LongIntvar:LongInt;
  1118.                       DefFormat:string;
  1119.                       Min,Max : LongInt);
  1120.  {}
  1121.  begin
  1122.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1123.      begin
  1124.          Check_Field_Number(DefID);
  1125.          FieldType     := IOLongInt;
  1126.          If Rules_Set then                 {5.00h}
  1127.             Set_Cursor(DefID)
  1128.          else
  1129.             Set_Misc_Field_Defaults(DefID);
  1130.          SPtr          := @LongIntVar;
  1131.          FieldStr      := Var_to_String(DefID);
  1132.          If DefFormat = '' then
  1133.             FieldFmt := '###########'
  1134.          else
  1135.             FieldFmt := DefFormat;
  1136.          If (max = 0) or (Max < Min) then
  1137.             LMax := 2147483647
  1138.          else
  1139.             LMax := Max;
  1140.          If (Min > LMax) then
  1141.             LMin := -2147483647
  1142.          else
  1143.             LMin := Min;
  1144.          FieldLen      := Max_String_Length(FieldFmt);
  1145.          Set_Cursor(DefID);           {5.00h}
  1146.      end;
  1147.  end; {of proc LongInt_Field}
  1148.  
  1149.  Procedure Date_Field(DefID:byte;
  1150.                       var Datevar:Dates;
  1151.                       DateFormat:byte;
  1152.                       DefFormat:string;
  1153.                       Min,Max : Dates);
  1154.  {}
  1155.  begin
  1156.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1157.      begin
  1158.          Check_Field_Number(DefID);
  1159.          FieldType     := IODate;
  1160.          If Rules_Set then                 {5.00h}
  1161.             Set_Cursor(DefID)
  1162.          else
  1163.             Set_Misc_Field_Defaults(DefID);
  1164.          SPtr          := @DateVar;
  1165.          If DateVar = 0 then
  1166.             FieldStr := ''
  1167.          else
  1168.             FieldStr      := Unformatted_date(Julian_to_Date(DateVar,DateFormat));
  1169.          If DefFormat = '' then
  1170.          begin
  1171.              Case DateFormat of
  1172.              DDMMYY,MMDDYY :       FieldFmt := '##/##/##';
  1173.              MMYY          :       FIeldFmt := '##/##';
  1174.              MMYYYY        :       FieldFmt := '##/####';
  1175.              DDMMYYYY,
  1176.              MMDDYYYY      :       FieldFmt := '##/##/####';
  1177.              end; {Case}
  1178.          end
  1179.          else
  1180.             FieldFmt := DefFormat;
  1181.          If (Max = 0) or (Max < Min) then
  1182.              DMax := 65535
  1183.          else
  1184.             DMax := Max;
  1185.          If Min > WMax then
  1186.             DMin := 0
  1187.          else
  1188.             DMin := MIn;
  1189.          DFormat := DateFormat;
  1190.          FieldLen      := Max_String_Length(FieldFmt);
  1191.          Set_Cursor(DefID);   {5.00h}
  1192.      end;
  1193.  end; {of proc Date_Field}
  1194.  
  1195.  Procedure Real_Field(DefID:byte;
  1196.                       var Realvar:Real;
  1197.                       DefFormat:string;
  1198.                       Min,Max : real);
  1199.  {}
  1200.  var p : byte;
  1201.  begin
  1202.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1203.      begin
  1204.          Check_Field_Number(DefID);
  1205.          FieldType     := IOReal;
  1206.          If Rules_Set then                 {5.00h}
  1207.             Set_Cursor(DefID)
  1208.          else
  1209.             Set_Misc_Field_Defaults(DefID);
  1210.          SPtr          := @RealVar;
  1211.          If DefFormat = '' then
  1212.             FieldFmt := '############'
  1213.          else
  1214.             FieldFmt := DefFormat;
  1215.          P := LastPos('.',FieldFmt);
  1216.          If P = 0 then
  1217.             RealDP  := Floating
  1218.          else
  1219.             RealDP := Length(FieldFmt) - P;
  1220.          If RealDP = 0 then
  1221.             Delete(FieldFmt,P,1);            {remove the end decimal place}
  1222.          If (Max = 0.0) or (Max < Min) then
  1223.             RMax := 1.7E+37                  {for compatibiltity with Turbo4}
  1224.          else
  1225.             RMax := Max;
  1226.          If Min > RMax then
  1227.             RMin := 2.9E-38                  {for compatibiltity with Turbo4}
  1228.          else
  1229.             RMin := Min;
  1230.          If (RealDP <> 0) and (RealDP <> Floating) then
  1231.             Right_Justify := true;
  1232.          If RealDP <> Floating then
  1233.             DisAllow_Char := ['.'];
  1234.          FieldStr      := Var_to_String(DefID);
  1235.          FieldLen      := Max_String_Length(FieldFmt);
  1236.          Set_Cursor(DefID);   {5.00h}
  1237.      end;
  1238.  end; {of proc Real_Field}
  1239. {$ENDIF}
  1240.  
  1241. Procedure Hilight(ID:byte);      {display cell in bright colors}
  1242. begin
  1243.     with Table[CurrentTable]^ do
  1244.          with FieldDefn[ID]^ do
  1245.               WriteAT(X,Y,ITTT.HiFCol,ITTT.HiBCol,
  1246.                       Formatted_String(FieldStr,FieldFmt,Right_Justify));
  1247. end;
  1248.  
  1249. Procedure LoLight(ID:byte);      {display cell in dim colors}
  1250. begin
  1251.     with Table[CurrentTable]^ do
  1252.          with FieldDefn[ID]^ do
  1253.              WriteAT(X,Y,ITTT.LoFCol,ITTT.LoBCol,
  1254.                       Formatted_String(FieldStr,FieldFmt,Right_Justify));
  1255. end;
  1256.  
  1257. Procedure Display_All_Fields;
  1258. var I : integer;
  1259. begin
  1260.     If not TableSet then
  1261.         IOTTT_Error(14,0.0);  {5.01}
  1262.     with Table[CurrentTable]^ do
  1263.     begin
  1264.         For I :=  1 to ITTT.TotalFields do
  1265.         begin
  1266.             FieldDefn[I]^.FieldStr := Var_To_String(I);    {fix 5.00 d}
  1267.             Set_Cursor(I);
  1268.             LoLight(I);
  1269.         end;
  1270.         ITTT.Displayed  := true;
  1271.     end; {with Table}
  1272. end;
  1273.  
  1274. Procedure Allow_Esc(OK:boolean);
  1275. begin
  1276.     If not TableSet then
  1277.         IOTTT_Error(14,0.0);  {5.01}
  1278.     Table[CurrentTable]^.ITTT.AllowEsc := OK;
  1279. end;    {proc Allow_Esc}
  1280.  
  1281. Procedure Allow_Beep(OK:boolean);
  1282. begin
  1283.     Table[CurrentTable]^.ITTT.Beep := OK;
  1284. end;    {proc Allow_Beep}
  1285.  
  1286. Procedure Init_Insert_Mode(ON:boolean);
  1287. begin
  1288.     Table[CurrentTable]^.ITTT.Insert := ON;
  1289. end;    {proc Init_Insert_Mode}
  1290.  
  1291. Procedure Dispose_Fields;
  1292. var I : integer;
  1293. begin
  1294.     If not TableSet then
  1295.         IOTTT_Error(14,0.0);  {5.01}
  1296.     with Table[CurrentTable]^ do
  1297.     begin
  1298.         If not ITTT.IO_FieldsSet then IOTTT_Error(10,0);
  1299.         For I := 0 to ITTT.TotalFields do
  1300.             FreeMem(FieldDefn[I],sizeof(FieldDefn[I]^));
  1301.         Reset_Table(ITTT);
  1302.     end; {with Table}
  1303. end; { proc Dispose_Fields}
  1304.  
  1305. Procedure Dispose_Tables;
  1306. var I : integer;
  1307. begin
  1308.     If not TableSet then
  1309.         IOTTT_Error(14,0.0);  {5.01}
  1310.     For I := 1 to TotalTables do
  1311.         FreeMem(Table[I],sizeOf(Table[I]^));
  1312.     TotalTables := 0;
  1313. end;
  1314.  
  1315. {
  1316. ****************************
  1317. *      Main Procedure      *
  1318. ****************************
  1319. }
  1320.  
  1321. Procedure Process_Input(StartField:byte);
  1322. var
  1323.     OldLine : array[1..160] of byte;
  1324.     Finished : boolean;
  1325.     SRefresh,SField : Byte;
  1326.  
  1327.     Procedure DisplayMessage(ID:byte);
  1328.     begin
  1329.         With Table[CurrentTable]^ do
  1330.              with FieldDefn[ID]^ do
  1331.              begin
  1332.                 If MsgX = 0 then   {Center the message}
  1333.                    MsgX := (80 - length(Message)) div 2;
  1334.                 PartSave(MsgX,MsgY,MsgX+length(Message),MsgY,OldLine);
  1335.                 WriteAT(MsgX,MsgY,ITTT.MsgFCol,ITTT.MsgBCol,Message);
  1336.              end;
  1337.     end;
  1338.  
  1339.     Procedure RemoveMessage(ID:byte);
  1340.     var I,LocC : integer;
  1341.     begin
  1342.         With Table[CurrentTable]^.FieldDefn[ID]^ do
  1343.              PartRestore(MsgX,MsgY,MsgX+length(Message),MsgY,OldLine);
  1344.     end; {sub sub proc RemoveMessage}
  1345.  
  1346.     Procedure Check_Refresh_State(Refresh:byte);
  1347.     {}
  1348.     var I : integer;
  1349.     begin
  1350.         with Table[CurrentTable]^ do
  1351.         Case Refresh of
  1352. {$IFDEF IOFULL}
  1353.         Refresh_None :; {do nothing}
  1354.         Refresh_Current: begin
  1355.                              FieldDefn[ITTT.CurrentField]^.FieldStr := Var_to_String(ITTT.CurrentField);
  1356.                              Set_Cursor(ITTT.CurrentField);  {5.00i}
  1357.                              LoLight(ITTT.CurrentField);
  1358.                          end;
  1359.         Refresh_All: begin
  1360.                          Display_All_Fields;
  1361.                      end;
  1362.         End_Input : begin
  1363.                         Display_All_Fields;
  1364.                         Finished := true;
  1365.                     end;
  1366. {$ELSE}
  1367.         Refresh_None   :; {do nothing}
  1368.         Refresh_Current: begin
  1369.                              FieldDefn[I]^.FieldStr := Var_To_String(I);{5.00k}
  1370.                              Set_Cursor(ITTT.CurrentField);   {5.00i}
  1371.                              LoLight(ITTT.CurrentField);
  1372.                          end;
  1373.         Refresh_All    : Display_All_Fields;
  1374.         End_Input      : begin
  1375.                              Display_All_Fields;
  1376.                              Finished := true;
  1377.                          end;
  1378. {$ENDIF}
  1379.         end; {Case}
  1380.     end; {of proc Check_refresh_State}
  1381.  
  1382.   Procedure Change_Fields(ID:byte);
  1383.   var
  1384.     ValidInput:byte;
  1385.     CField : byte;
  1386.     Refresh : byte;
  1387.   begin
  1388.       with Table[CurrentTable]^ do
  1389.       begin
  1390. {$IFDEF IOFULL}
  1391.           Validate_Field(ITTT.CurrentField,ValidInput);
  1392.           If ValidInput <> Valid then
  1393.              exit;
  1394. {$ENDIF}
  1395.           String_to_Var(ITTT.CurrentField);
  1396.           LoLight(ITTT.CurrentField);
  1397.           If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1398.              RemoveMessage(ITTT.CurrentField);
  1399.           {Now call the "leave field" hook}
  1400.           CField := ITTT.CurrentField;
  1401.           Refresh := Refresh_None;
  1402.           {$IFNDEF VER40}
  1403.           ITTT.LeaveFieldHook(CField,Refresh);
  1404.           {$ELSE}
  1405.           If IO_LeaveHook <> Nil then
  1406.              CallLeaveFieldHook(CField,Refresh);
  1407.           {$ENDIF}
  1408.           If CField <> ITTT.CurrentField then
  1409.              ID := CField; {user wants to go to a specific field}
  1410.           Check_Refresh_State(Refresh);
  1411.           If Finished then exit;
  1412.           If ID = 0 then
  1413.           begin
  1414.               Finished := true;
  1415.           end
  1416.           else
  1417.           begin
  1418.               ITTT.CurrentField := ID;
  1419.               CField := ID;
  1420.               {Enter Field Hook}
  1421.               Repeat
  1422.                    ITTT.CurrentField := CField;
  1423.                    Refresh := Refresh_None;
  1424.                    {$IFNDEF VER40}
  1425.                    ITTT.EnterFieldHook(CField,Refresh);
  1426.                    {$ELSE}
  1427.                    If IO_EnterHook <> Nil then
  1428.                       CallEnterFieldHook(CField,Refresh);
  1429.                    {$ENDIF}
  1430.                    Check_Refresh_State(Refresh);
  1431.                    If Finished then exit;
  1432.               until CField = ITTT.CurrentField;
  1433.               If (ITTT.CurrentField < 1)
  1434.               or (ITTT.CurrentField > ITTT.TotalFields) then
  1435.                   exit;                      {5.00b}
  1436.               HiLight(ITTT.CurrentField);
  1437.               If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1438.                  DisplayMessage(ITTT.CurrentField);
  1439.               With FieldDefn[ITTT.CurrentField]^ do
  1440.                   GotoXY(CursorX,Y);
  1441.               {Ding;}
  1442.           end;  {If ID = 0};
  1443.      end; {with Table}
  1444.   end;  {proc change fields}
  1445.  
  1446.   Procedure Erase_Field(ID:byte);
  1447.   begin
  1448.       with Table[CurrentTable]^.FieldDefn[ID]^ do
  1449.       begin
  1450.           FieldStr := '';
  1451.           String_to_Var(ID);
  1452.           Set_Cursor(ID);
  1453.       end;
  1454.   end;
  1455.  
  1456.   Procedure Global_Erase;
  1457.   var
  1458.      I : integer;
  1459.      S : string;
  1460.      Ch : char;
  1461.   begin
  1462.       Ding;
  1463.       S := 'Erase all entries!  Are you sure? (Y/N)';
  1464.       With Table[CurrentTable]^.ITTT do
  1465.           TempMessageCh(1,ErrorLine,MsgFCol,MsgBCol,PadCenter(S,80,' '),CH);
  1466.       If Upcase(Ch) <> 'Y' then exit;
  1467.       with Table[CurrentTable]^ do
  1468.       begin
  1469.           For I :=  1 to ITTT.TotalFields do
  1470.               Erase_Field(I);
  1471.           Display_All_Fields;
  1472.           ITTT.CurrentField := 1;
  1473.       end;
  1474.   end;
  1475.  
  1476.   Procedure Cursor_Right;
  1477.   begin
  1478.       With Table[CurrentTable]^ do
  1479.            with FieldDefn[ITTT.CurrentField]^ do
  1480.            begin
  1481.               If (Right_Justify and (StrLocX < length(FieldStr)) and (StrLocX < FieldLen)) or
  1482.                  ((Right_Justify = false) and (StrLocX <= length(FieldStr)) and (StrLocX < FieldLen))then
  1483.               begin
  1484.                   Inc(StrLocX);
  1485.                   Repeat
  1486.                        Inc(CursorX);
  1487.                   Until FieldFmt[CursorX + 1 - X] in FmtChars;
  1488.               end;
  1489.               GotoXY(CursorX,Y);
  1490.           end; {with}
  1491.   end; {Proc Cursor_Right}
  1492.  
  1493.   Procedure Cursor_Left;
  1494.   begin
  1495.       with Table[CurrentTable]^ do
  1496.            With FieldDefn[ITTT.CurrentField]^ do
  1497.            begin
  1498.                If (StrLocX > 1)
  1499.                or ( Right_Justify and (StrLocX > 0) and (length(FieldStr) <> FieldLen) ) then
  1500.                begin
  1501.                    dec(StrLocX);
  1502.                    Repeat
  1503.                         dec(CursorX);
  1504.                    Until FieldFmt[CursorX + 1 - X] in FmtChars;
  1505.                end;
  1506.            end;  {with}
  1507.   end;  {Proc Cursor_left}
  1508.  
  1509.   Procedure Cursor_Home;
  1510.   var
  1511.     Counter1, Counter2 : byte;
  1512.   begin
  1513.       with Table[CurrentTable]^ do
  1514.            With FieldDefn[ITTT.CurrentField]^ do
  1515.                 Repeat
  1516.                      Counter1 := CursorX;
  1517.                      Cursor_Left;
  1518.                 Until Counter1 = CursorX;
  1519.   end;  {Proc Cursor_Home}
  1520.  
  1521.   Procedure Delete_Char;
  1522.   var
  1523.     I : integer;
  1524.   begin
  1525.       with Table[CurrentTable]^ do
  1526.            with FieldDefn[ITTT.CurrentField]^ do   {non format characters}
  1527.            begin
  1528.                If StrLocX > 0 then
  1529.                begin
  1530.                   Delete(FieldStr,StrLocX,1);
  1531.                   If Right_Justify then
  1532.                      Dec(StrLocX);
  1533.                end;
  1534.            end;  {with}
  1535.   end;  {Delete_Chars}
  1536.  
  1537.   Procedure Backspaced;
  1538.   begin
  1539.       with Table[CurrentTable]^ do
  1540.            with FieldDefn[ITTT.CurrentField]^ do
  1541.            begin
  1542.                If StrLocX > 1 then
  1543.                begin
  1544.                    If Right_Justify then
  1545.                    begin
  1546.                        Delete(FieldStr,pred(StrLocX),1);
  1547.                        Dec(StrLocX);
  1548.                    end
  1549.                    else
  1550.                    begin
  1551.                        Cursor_Left;
  1552.                        Delete(FieldStr,StrLocX,1);
  1553.                    end;
  1554.                end;
  1555.            end;  {with}
  1556.   end;  { Proc Backspaced }
  1557.  
  1558.   Procedure Finish_Input;
  1559.   {}
  1560.   var ValidInput : byte;
  1561.   begin
  1562. {$IFDEF IOFULL}
  1563.       Validate_Field(Table[CurrentTable]^.ITTT.CurrentField,ValidInput);
  1564.       If ValidInput = Valid then
  1565.       begin
  1566. {$ENDIF}
  1567.           String_to_Var(Table[CurrentTable]^.ITTT.CurrentField);
  1568.           Finished := true;
  1569. {$IFDEF IOFULL}
  1570.       end;
  1571. {$ENDIF}
  1572.   end; {of proc Finish_Input}
  1573.  
  1574.   Procedure Insert_Character(K : char);
  1575.   begin
  1576.       with Table[CurrentTable]^ do
  1577.            with FieldDefn[ITTT.CurrentField]^ do
  1578.            begin
  1579.                If (length(FieldStr) < FieldLen) then
  1580.                begin
  1581.                    If Right_Justify then
  1582.                    begin
  1583.                        Inc(StrLocX);
  1584.                        Insert(K,FieldStr,StrLocX);
  1585.                    end
  1586.                    else
  1587.                    begin
  1588.                        Insert(K,FieldStr,StrLocX);
  1589.                        Cursor_Right;
  1590.                    end;
  1591.                end
  1592.                else
  1593.                If (FieldLen = 1) then    {fix 5.00c}
  1594.                    FieldStr := K
  1595.                else
  1596.                    Ding;
  1597.       end;
  1598.   end;
  1599.  
  1600.   Procedure OverType_Character(K : char);
  1601.   begin
  1602.       with Table[CurrentTable]^ do
  1603.            with FieldDefn[ITTT.CurrentField]^ do
  1604.            begin
  1605.                If (StrLocX = 0) and Right_Justify then
  1606.                begin
  1607.                    Insert(K,FieldStr,StrLocX);
  1608.                    Inc(StrLocX);
  1609.                end
  1610.                else
  1611.                begin
  1612.                    Delete(FieldStr,StrLocX,1);
  1613.                    Insert(K,FieldStr,StrLocX);
  1614.                    Cursor_Right;
  1615.                end;
  1616.            end;
  1617.   end;
  1618.  
  1619.   Procedure Activity;
  1620.   var
  1621.     K : char;
  1622.     ReturnStr: string;
  1623.     Prior_CursorX : byte;
  1624.     ValidInput : byte;
  1625.     OldField : byte;
  1626.     CField : byte;
  1627.     Refresh: byte;
  1628.   begin
  1629.       OldField := Table[CurrentTable]^.ITTT.CurrentField;
  1630.       K := Getkey;
  1631.       {now the character hook}
  1632.       With Table[CurrentTable]^ do
  1633.       begin
  1634.           CField := ITTT.CurrentField;
  1635.           ReFresh := Refresh_None;
  1636.           {$IFNDEF VER40}
  1637.           ITTT.CharHook(K,CField,Refresh);
  1638.           {$ELSE}
  1639.           If IO_CharHook <> Nil then
  1640.              CallCharHook(K,CField,Refresh);
  1641.           {$ENDIF}
  1642.           Check_Refresh_State(Refresh);
  1643.           If CField <> ITTT.CurrentField then
  1644.              Change_Fields(CField); {user wants to go to a specific field}
  1645.           If K = ITTT.FinishChar then
  1646.              Finish_Input
  1647.           else
  1648. {$IFDEF IOFULL}
  1649.              If  (FieldDefn[ITTT.CurrentField]^.Allow_Char <> [#0])
  1650.              and (not (K in FieldDefn[ITTT.CurrentField]^.Allow_Char))
  1651.              and (not (K in Control_Char)) then
  1652.              begin
  1653.                  If K <> No_Char then          {5.00g}
  1654.                     Ding;
  1655.                  Exit;
  1656.              end;
  1657. {$ELSE}
  1658. ;
  1659. {$ENDIF}
  1660.       end;
  1661.  
  1662.       If (K <> No_Char)
  1663.       and (Finished = false) then
  1664.       Case K of
  1665.       #132,   {mouse right but}
  1666.       IOEsc : If Table[CurrentTable]^.ITTT.AllowEsc then
  1667.                  begin
  1668.                      Finished := true;
  1669.                   end
  1670.                   else Ding;
  1671.       #32..#126 : with Table[CurrentTable]^ do
  1672.                       with FieldDefn[ITTT.CurrentField]^ do
  1673.                       begin
  1674.                           If FieldFmt[CursorX - X + 1] = '!' then K := upcase(K);
  1675. {$IFDEF IOFULL}
  1676.                           If (
  1677.                                (Allow_Char = [#0])
  1678.                                or ((Allow_Char <> [#0]) and (K in Allow_Char))
  1679.                              )
  1680.                           and
  1681.                              (
  1682.                                (DisAllow_Char = [#0])
  1683.                                or ((DisAllow_Char <> [#0]) and ((K in DisAllow_Char)= false))
  1684.                              )
  1685.                           then
  1686.                           begin
  1687. {$ENDIF}
  1688.                               If ((K in ['0'..'9','.','-','e','E']) and (FieldFmt[CursorX - X + 1] = '#'))
  1689.                               or ((K in ['a'..'z','A'..'Z',' ',',','.',';',':']) and
  1690.                                                         (FieldFmt[CursorX - X + 1] = '@'))
  1691.                               or (FieldFmt[CursorX - X + 1] = '*')
  1692.                               or (FieldFmt[CursorX - X + 1] = '!') then
  1693.                               begin
  1694. {$IFDEF IOFULL}
  1695.                                   If FirstCharPress then
  1696.                                   begin
  1697.                                       If Erase_Default then
  1698.                                          Erase_Field(ITTT.CurrentField);
  1699.                                       FirstCharPress := false;
  1700.                                   end;
  1701. {$ENDIF}
  1702.                                   If (ITTT.Insert) then
  1703.                                      Insert_Character(K)
  1704.                                   else
  1705.                                      OverType_Character(K);
  1706.                               end
  1707.                               else Ding; {end if K in statement}
  1708. {$IFDEF IOFULL}
  1709.                           end; {if}
  1710. {$ENDIF}
  1711.                       end;  {with}
  1712.       #133,      {mouse left but}
  1713.       #131,      {mouse right}
  1714.       IORightFld,
  1715.       IOTab,
  1716.       IOEnter :  with Table[CurrentTable]^ do
  1717.                      Change_Fields(FieldDefn[ITTT.CurrentField]^.RightField);
  1718.       #130,      {mouse left}
  1719.       IOLeftFld,
  1720.       IOShiftTab : with Table[CurrentTable]^ do
  1721.                        Change_Fields(FieldDefn[ITTT.CurrentField]^.LeftField);
  1722.       IOBackSp : Backspaced;
  1723.       IODel    : Delete_Char;
  1724.       IOLeft   : Cursor_Left;
  1725.       IORight  : Cursor_Right;
  1726.       #128,    {mouse up}
  1727.       IOUp     : with Table[CurrentTable]^ do
  1728.                       Change_Fields(FieldDefn[ITTT.CurrentField]^.UpField);
  1729.       #129,    {mouse down}
  1730.       IODown   : with Table[CurrentTable]^ do
  1731.                       Change_Fields(FieldDefn[ITTT.CurrentField]^.DownField);
  1732.       IOErase    :with Table[CurrentTable]^ do
  1733.                        Erase_Field(ITTT.CurrentField);
  1734.       IOTotErase : Global_Erase;
  1735.       IOIns      : with Table[CurrentTable]^ do
  1736.                    begin
  1737.                        ITTT.Insert := not ITTT.Insert;
  1738.                        {$IFNDEF VER40}
  1739.                        ITTT.InsertProc(ITTT.Insert);
  1740.                        {$ELSE}
  1741.                         If IO_InsertHook <> Nil then
  1742.                            CallInsertHook(ITTT.Insert);
  1743.                        {$ENDIF}
  1744.                    end;
  1745.       #199       : Cursor_Home;
  1746.       #207       : with Table[CurrentTable]^ do
  1747.                       Set_Cursor(ITTT.CurrentField);
  1748.       else Ding;
  1749.       end; {case}
  1750.       HiLight(Table[CurrentTable]^.ITTT.CurrentField);
  1751.       with Table[CurrentTable]^ do
  1752.            with FieldDefn[ITTT.CurrentField]^ do
  1753.                 GotoXY(CursorX,Y);
  1754.       
  1755. {$IFDEF IOFULL}
  1756.       with Table[CurrentTable]^ do
  1757.            with FieldDefn[ITTT.CurrentField]^ do
  1758.            begin
  1759.                If  (FirstCharPress = false)
  1760.                and (Jump_Full)
  1761.                and (StrLocX = FieldLen)
  1762.                and (Length(FieldStr) = FieldLen)
  1763.                and (ITTT.Insert)
  1764.                and (K in [#32..#126])
  1765.                and (Jump_Full) then
  1766.                    Change_Fields(FieldDefn[ITTT.CurrentField]^.RightField);
  1767.            end;
  1768. {$ENDIF}
  1769.       If Table[CurrentTable]^.ITTT.CurrentField <> OldField then  {5.00l}
  1770.          FirstCharPress := true
  1771.       else
  1772.          FirstCharPress := false;
  1773.       I_Char := K;
  1774.   end;    {Proc Activity}
  1775.  
  1776.  
  1777. begin   {Process_Input}
  1778.     If not TableSet then
  1779.         IOTTT_Error(14,0.0);  {5.01}
  1780.     with Table[CurrentTable]^ do
  1781.     begin
  1782.         If ITTT.Displayed = false then Display_All_Fields;
  1783.         If StartField in [1..ITTT.TotalFields] then
  1784.            ITTT.CurrentField := StartField
  1785.         else
  1786.            StartField := 1;
  1787.         {Enter Field Hook}        {5.00m}
  1788.         SField := StartField;
  1789.         Finished := false;
  1790.         Repeat
  1791.              ITTT.CurrentField := SField;
  1792.              SRefresh := Refresh_None;
  1793.              {$IFNDEF VER40}
  1794.              ITTT.EnterFieldHook(SField,SRefresh);
  1795.              {$ELSE}
  1796.              If IO_EnterHook <> Nil then
  1797.                 CallEnterFieldHook(SField,SRefresh);
  1798.              {$ENDIF}
  1799.              Check_Refresh_State(SRefresh);
  1800.              If Finished then exit;
  1801.         until SField = ITTT.CurrentField;
  1802.         Hilight(ITTT.CurrentField);
  1803.         If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1804.         DisplayMessage(Table[CurrentTable]^.ITTT.CurrentField);
  1805.         GotoXY(FieldDefn[ITTT.CurrentField]^.CursorX,
  1806.                FieldDefn[ITTT.CurrentField]^.Y);
  1807.         FirstCharPress := true;
  1808.         {$IFNDEF VER40}                          {5.00j}
  1809.         ITTT.InsertProc(ITTT.Insert);
  1810.         {$ELSE}
  1811.         If IO_InsertHook <> Nil then
  1812.            CallInsertHook(ITTT.Insert);
  1813.         {$ENDIF}
  1814.         repeat
  1815.              Activity;
  1816.         until Finished;
  1817.     end;
  1818. end;   {Process_Input}
  1819.  
  1820. begin  {Initial Auto proc}
  1821.     CurrentTable := 1;
  1822.     TableSet := False;
  1823. end.
  1824.  
  1825.